home *** CD-ROM | disk | FTP | other *** search
/ BMUG PD-ROM A / PD-ROM A.iso / Programming / Programming Languages / MacOberon / MacOberon (tools) / PopupElems.Mod (.txt) < prev    next >
Encoding:
Oberon Text  |  1991-02-15  |  9.3 KB  |  192 lines  |  [.Ob./.Ob2]
  1. Syntax10.Scn.Fnt
  2. MODULE PopupElems;    (* Michael Franz, 20.11.90 -- "Hypertext without Surprises" *)
  3.     IMPORT
  4.         Oberon, Input, Display, Viewers, Files, Fonts, Printer, Texts, TextFrames, MenuViewers, WriteTexts, WriteFrames, WriteParcs;
  5.     CONST
  6.         CR=0DX;
  7.         edw=4; edh=2; mdw=3; mdh=1;
  8.         ElemFont="Syntax12m.Scn.Fnt";
  9.         EditMenu="System.Close  System.Grow";
  10.     TYPE
  11.         PopupElem=POINTER TO PopupElemDesc;
  12.         PopupElemDesc=RECORD (WriteTexts.ElemDesc)
  13.             name: ARRAY 32 OF CHAR;
  14.             menu: Texts.Text;
  15.             dft, w, lin, min, n: INTEGER
  16.         END;
  17.         EditFrame=POINTER TO EditFrameDesc;
  18.         EditFrameDesc=RECORD (TextFrames.FrameDesc)
  19.             elem: PopupElem
  20.         END;
  21.         buf: Texts.Buffer;
  22.         elfnt: Fonts.Font;    (* font of element box text *)
  23.         lsp, loff, marg: INTEGER;    (* line space, line offset, window margin *)
  24. (* auxiliary *)
  25.     PROCEDURE Min(x, y: INTEGER): INTEGER;
  26.     BEGIN    IF    x<y    THEN    RETURN x    ELSE    RETURN y    END
  27.     END Min;
  28.     PROCEDURE Max(x, y: INTEGER): INTEGER;
  29.     BEGIN    IF    x>y    THEN    RETURN x    ELSE    RETURN y    END
  30.     END Max;
  31. (* internal consistency *)
  32.     PROCEDURE SetupMenu(E: PopupElem);
  33.         VAR ch: CHAR; w, pdx, px, py, pw, ph: INTEGER; pat: LONGINT; r: Texts.Reader;
  34.     BEGIN    Texts.OpenReader(r, E.menu, 0); E.w:=0; E.n:=1; E.lin:=0; w:=0;
  35.         LOOP    Texts.Read(r, ch);
  36.             IF    r.eot    THEN    E.w:=Max(E.w, w); E.dft:=Min(E.dft, E.n); RETURN
  37.             ELSIF    ch=CR    THEN    E.w:=Max(E.w, w); w:=0; INC(E.n)
  38.             ELSE    E.lin:=Max(E.lin, r.fnt.height); E.min:=Min(E.min, r.fnt.minY);
  39.                 Display.GetChar(r.fnt.raster, ch, pdx, px, py, pw, ph, pat); INC(w, pdx)
  40.             END
  41.         END
  42.     END SetupMenu;
  43.     PROCEDURE SetupElem(E: PopupElem; s: ARRAY OF CHAR);
  44.         VAR ch: CHAR; i, w, pdx, px, py, pw, ph: INTEGER; pat: LONGINT;
  45.     BEGIN    i:=0; w:=2*edw+4;
  46.         LOOP    ch:=s[i]; E.name[i]:=ch;
  47.             IF    ch=0X    THEN    E.DX:=(w+1)*Display.Unit; E.W:=w*Display.Unit; E.H:=(lsp+2*edh+2)*Display.Unit; EXIT
  48.             ELSE    Display.GetChar(elfnt.raster, ch, pdx, px, py, pw, ph, pat); INC(w, pdx); INC(i)    END
  49.         END
  50.     END SetupElem;
  51. (* interactive editing of popup menus *)
  52.     PROCEDURE* EditHandle(F: Display.Frame; VAR msg: Display.FrameMsg);
  53.     BEGIN
  54.         WITH    F: EditFrame    DO    TextFrames.Handle(F, msg);
  55.             IF    ((msg IS Oberon.InputMsg)&(msg(Oberon.InputMsg).id=Oberon.consume)) OR (msg IS TextFrames.UpdateMsg)
  56.             THEN    SetupMenu(F.elem)    END
  57.         END
  58.     END EditHandle;
  59.     PROCEDURE EditOpen(E: PopupElem);
  60.         VAR x, y: INTEGER; V: Viewers.Viewer; F: EditFrame;
  61.     BEGIN    Oberon.AllocateUserViewer(Oberon.Par.vwr.X, x, y); NEW(F); F.elem:=E;
  62.         TextFrames.Open(F, EditHandle, E.menu, 0, Display.black, TextFrames.menuH+marg, marg, marg, marg, 0);
  63.         V:=MenuViewers.New(TextFrames.NewMenu(E.name, EditMenu), F, TextFrames.menuH, x, y)
  64.     END EditOpen;
  65. (* file input/output *)
  66.     PROCEDURE Load(VAR r: Files.Rider; E: PopupElem);
  67.         VAR i: INTEGER; pos, len: LONGINT; f: Files.File; s: ARRAY 32 OF CHAR; ch: CHAR;
  68.     BEGIN    i:=0;    REPEAT    Files.Read(r, ch); s[i]:=ch; INC(i)    UNTIL    ch=0X;    s[i-1]:="."; s[i]:="."; s[i+1]:="."; s[i+2]:=0X;
  69.         Files.Read(r, ch); E.dft:=ORD(ch); SetupElem(E, s); E.menu:=TextFrames.Text("");
  70.         pos:=Files.Pos(r)+2; f:=Files.Base(r); Texts.Load(E.menu, f, pos, len); Files.Set(r, f, pos+len)
  71.     END Load;
  72.     PROCEDURE StoreString(VAR r: Files.Rider; s: ARRAY OF CHAR);
  73.         VAR i: INTEGER;
  74.     BEGIN    i:=0;    WHILE    s[i] # 0X    DO    INC(i)    END;    Files.WriteBytes(r, s, i-3); Files.Write(r, 0X)
  75.     END StoreString;
  76.     PROCEDURE Store(VAR r: Files.Rider; E: PopupElem);
  77.         VAR pos, len: LONGINT; f: Files.File;
  78.     BEGIN    StoreString(r, "PopupElems.Alloc..."); StoreString(r, E.name); Files.Write(r, CHR(E.dft MOD 128));
  79.         pos:=Files.Pos(r); f:=Files.Base(r); len:=E.menu.len; Texts.Store(E.menu, f, pos, len); Files.Set(r, f, pos+len)
  80.     END Store;
  81. (* graphics *)
  82.     PROCEDURE Box(x, y, w, h: INTEGER);
  83.     BEGIN
  84.         Display.ReplConst(Display.white, x, y, w, 2, Display.replace);
  85.         Display.ReplConst(Display.white, x, y+h-2, w, 2, Display.replace);
  86.         Display.ReplConst(Display.white, x, y+2, 2, h-4, Display.replace);
  87.         Display.ReplConst(Display.white, x+w-2, y+2, 2, h-4, Display.replace);
  88.         Display.ReplConst(Display.black, x+2, y+2, w-4, h-4, Display.replace)
  89.     END Box;
  90.     PROCEDURE PrintElem(E: PopupElem; x, y, w, h: INTEGER);
  91.     BEGIN    Printer.ReplConst(x, y, w, 2); Printer.ReplConst(x, y+h-2, w, 2);
  92.         Printer.ReplConst(x, y+2, 2, h-4); Printer.ReplConst(x+w-2, y+2, 2, h-4);
  93.         Printer.String(x+edw+2, y+edh+2+loff, E.name, elfnt)
  94.     END PrintElem;
  95.     PROCEDURE DrawElem(E: PopupElem; x, y, w, h: INTEGER);
  96.         VAR i, pdx, px, py, pw, ph: INTEGER; pat: LONGINT;
  97.     BEGIN    Box(x, y, w, h); INC(x, edw+2); INC(y, edh+2-loff); i:=0;
  98.         WHILE    E.name[i] >= " "    DO    Display.GetChar(elfnt.raster, E.name[i], pdx, px, py, pw, ph, pat);
  99.             Display.CopyPattern(Display.white, pat, x+px, y+py, Display.replace); INC(x, pdx); INC(i)
  100.         END
  101.     END DrawElem;
  102.     PROCEDURE DrawMenu(E: PopupElem; x, y, w, h: INTEGER);
  103.         VAR xl, pdx, px, py, pw, ph: INTEGER; pat: LONGINT; r: Texts.Reader; ch: CHAR;
  104.     BEGIN    Box(x, y, w, h); Texts.OpenReader(r, E.menu, 0); xl:=x+mdw+2; x:=xl; y:=y+h-E.lin-E.min-mdh-2;
  105.         LOOP    Texts.Read(r, ch);
  106.             IF    r.eot    THEN    RETURN
  107.             ELSIF    ch=CR    THEN    y:=y-E.lin; x:=xl
  108.             ELSE    Display.GetChar (r.fnt.raster, ch, pdx, px, py, pw, ph, pat);
  109.                 Display.CopyPattern(Display.white, pat, x+px, y+py, Display.replace); INC(x, pdx)
  110.             END
  111.         END
  112.     END DrawMenu;
  113. (* actions *)
  114.     PROCEDURE Show(E: PopupElem; x, y, w, h: INTEGER; VAR cmd: INTEGER);
  115.         VAR mx, my, top, bot, left, right, newCmd: INTEGER; keys: SET;
  116.     BEGIN    left:=x+3; right:=x+w-3; bot:=y+mdh+3; top:=y+h-mdh-2; Oberon.RemoveMarks(x, y, w, h);
  117.         Oberon.FadeCursor(Oberon.Mouse); Display.CopyBlock(x, y, w, h, x, -h, Display.replace);
  118.         DrawMenu(E, x, y, w, h); Display.ReplConst(Display.white, x+3, top-cmd*E.lin-E.lin, w-6, E.lin, Display.invert);
  119.         REPEAT    Input.Mouse(keys, mx, my); Oberon.DrawCursor(Oberon.Mouse, Oberon.Arrow, mx, my);
  120.             IF    keys * {0, 2} # {}    THEN    Oberon.FadeCursor(Oberon.Mouse); Display.CopyBlock(x, -h, w, h, x, y, Display.replace);
  121.                 IF    0 IN keys    THEN    EditOpen(E)    END;
  122.                 REPEAT    Input.Mouse(keys, mx, my); Oberon.DrawCursor(Oberon.Mouse, Oberon.Arrow, mx, my)    UNTIL keys={};
  123.                 cmd:=-1; RETURN
  124.             ELSIF    (mx>=left) & (mx<=right) & (my>=bot) & (my<=top)    THEN    newCmd:=(top-my) DIV E.lin;
  125.                 IF    newCmd # cmd    THEN
  126.                     IF    cmd # -1    THEN    Display.ReplConst(Display.white, x+3, top-cmd*E.lin-E.lin, w-6, E.lin, Display.invert)    END;
  127.                     Display.ReplConst(Display.white, x+3, top-newCmd*E.lin-E.lin, w-6, E.lin, Display.invert); cmd:=newCmd
  128.                 END
  129.             ELSIF    cmd # -1    THEN
  130.                 Display.ReplConst(Display.white, x+3, top-cmd*E.lin-E.lin, w-6, E.lin, Display.invert); cmd:=-1
  131.             END
  132.         UNTIL    keys={};
  133.         Oberon.FadeCursor(Oberon.Mouse); Display.CopyBlock(x, -h, w, h, x, y, Display.replace);
  134.     END Show;
  135.     PROCEDURE Popup(E: PopupElem; x, y: INTEGER);
  136.         VAR mx, my, w, h, i, j, cmd, res: INTEGER; cmdStr: ARRAY 32 OF CHAR; r: Texts.Reader; ch: CHAR; keys: SET;
  137.     BEGIN    Input.Mouse(keys, mx, my); w:=E.w+2*mdw+4; h:=E.n*E.lin+2*mdh+4;
  138.         y:=Max(my-h+E.lin+E.dft*E.lin, 0); cmd:=E.dft;
  139.         IF    x+w > Display.Width    THEN    x:=Display.Width-w    END;
  140.         IF    y+h > Display.Height    THEN    y:=Display.Height-h    END;
  141.         Show(E, x, y, w, h, cmd);
  142.         IF    cmd > -1    THEN    E.dft:=cmd; j:=0; Texts.OpenReader(r, E.menu, 0); Texts.Read(r, ch);
  143.             WHILE    j < cmd    DO    IF    ch=CR     THEN    INC(j)    END;    Texts.Read(r, ch)    END;
  144.             i:=0;    WHILE    (ch>" ") & (ch#CR) & (i<32)    DO    cmdStr[i]:=ch; INC(i); Texts.Read(r, ch)    END;    cmdStr[i]:=0X;
  145.             Oberon.Par.vwr:=Viewers.This(x, y); Oberon.Par.frame:=Oberon.Par.vwr.dsc;
  146.             Oberon.Par.text:=E.menu; Oberon.Par.pos:=Texts.Pos(r); Oberon.Call(cmdStr, Oberon.Par, FALSE, res)
  147.         END
  148.     END Popup;
  149. (* element *)
  150.     PROCEDURE* Handle(E: WriteTexts.Elem; VAR msg: Display.FrameMsg);
  151.         VAR e: PopupElem;
  152.     BEGIN
  153.         WITH    E: PopupElem    DO
  154.             IF    msg IS WriteTexts.DrawMsg    THEN
  155.                 WITH msg: WriteTexts.DrawMsg DO
  156.                     DrawElem(E, msg.X0, msg.Y0, SHORT(E.W DIV msg.unit), SHORT(E.H DIV msg.unit));
  157.                 END
  158.             ELSIF    msg IS WriteTexts.PrintMsg    THEN
  159.                 WITH    msg: WriteTexts.PrintMsg    DO
  160.                     PrintElem(E, msg.X0, msg.Y0, SHORT(E.W DIV msg.unit), SHORT(E.H DIV msg.unit))
  161.                 END
  162.             ELSIF    msg IS WriteTexts.LoadMsg    THEN    Load(msg(WriteTexts.LoadMsg).r, E); SetupMenu(E)
  163.             ELSIF    msg IS WriteTexts.StoreMsg THEN    Store(msg(WriteTexts.StoreMsg).r, E)
  164.             ELSIF    msg IS WriteTexts.CopyMsg    THEN
  165.                 WITH msg: WriteTexts.CopyMsg DO
  166.                     IF    msg.e=NIL    THEN    NEW(e); msg.e:=e    ELSE    e:=msg.e(PopupElem)    END;
  167.                     e.name:=E.name; e.dft:=E.dft; e.w:=E.w; e.lin:=E.lin; e.min:=E.min; e.n:=E.n;
  168.                     e.menu:=TextFrames.Text(""); Texts.Save(E.menu, 0, E.menu.len, buf); Texts.Append(e.menu, buf)
  169.                 END
  170.             ELSIF    msg IS WriteFrames.TrackMsg    THEN
  171.                 WITH    msg: WriteFrames.TrackMsg    DO
  172.                     IF    msg.keys={1}    THEN    Popup(E, msg.X0, msg.Y0)    END
  173.                 END
  174.             END
  175.         END
  176.     END Handle;
  177.     PROCEDURE Alloc*;
  178.         VAR e: PopupElem;
  179.     BEGIN    NEW(e); e.handle:=Handle; Oberon.Par(WriteTexts.AllocPar).e:=e
  180.     END Alloc;
  181.     PROCEDURE Insert*;
  182.         VAR E: PopupElem; S: Texts.Scanner; T: WriteTexts.Text; M: Oberon.CopyOverMsg;
  183.     BEGIN    Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(S);
  184.         IF    S.class #Texts.String    THEN    S.s:="Popup"    END;
  185.         NEW(E); SetupElem(E, S.s); E.menu:=TextFrames.Text(""); SetupMenu(E);
  186.         WriteTexts.OpenElem(E, Handle, E.DX, E.W, E.H);
  187.         T:=WriteFrames.Text("", WriteParcs.defParc); WriteTexts.AppendElem(T, E);
  188.         M.text:=T; M.beg:=0; M.end:=T.len; Oberon.FocusViewer.handle(Oberon.FocusViewer, M)
  189.     END Insert;
  190. BEGIN    elfnt:=Fonts.This(ElemFont); lsp:=elfnt.height+edh; loff:=elfnt.minY; marg:=Fonts.Default.height DIV 2; NEW(buf); Texts.OpenBuf(buf)
  191. END PopupElems.
  192.